home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / formset / formset.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  7KB  |  198 lines
  1. {
  2.                                Saxman Software
  3.                         Programmer Productivity Series
  4.                              Delphi Custom Controls
  5.                          Copyright 1995, Jim Standley
  6.  
  7.                                 FormSet Control
  8. }
  9. unit Formset;
  10.  
  11. {--------------------------------} Interface {-------------------------------}
  12.  
  13. uses
  14.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  15.   Forms, Dialogs, Tabs;
  16.  
  17. type
  18.  
  19.    TFTOpen  = (ftoSizeBookToPage, ftoSizePageToBook);
  20.    TFTClose = (ftcNeverRelease, ftcAlwaysRelease, ftcMaybeRelease);
  21.  
  22.    TFormTab = class
  23.       Form    : TForm;
  24.       OnOpen  : TFTOpen;
  25.       OnClose : TFTClose;
  26.    end;
  27.  
  28.    TTabLoadEvent = procedure(Sender   : TObject;
  29.                              TabIndex : Integer;
  30.                              FormTab  : TFormTab) of object;
  31.  
  32.    TFormSet = class(TTabSet)
  33.  
  34.    private
  35.       FOnClick       : TNotifyEvent;
  36.       FOnChange      : TTabChangeEvent;
  37.       FOnTabLoad     : TTabLoadEvent;
  38.       OldTabIndex    : Integer;
  39.       InternalChange : Boolean;
  40.       ParentHeight   : Integer;
  41.       ParentWidth    : Integer;
  42.       Procedure      TabClose(OldTabIndex: Integer);
  43.       Procedure      TabOpen(NewTabIndex: Integer);
  44.       Function       ConfigureTab(TabIndex: Integer): Boolean;
  45.       constructor    Create(Owner: TComponent); override;
  46.    protected
  47.       procedure Click; override;
  48.    public
  49.  
  50.    published
  51.       property OnClick   : TNotifyEvent    read FOnClick   write FOnClick;
  52.       property OnChange  : TTabChangeEvent read FOnChange  write FOnChange;
  53.       property OnTabLoad : TTabLoadEvent   read FOnTabLoad write FOnTabLoad;
  54.    end;
  55.  
  56.    procedure Register;
  57.  
  58. {-----------------------------} Implementation {-----------------------------}
  59.  
  60.  
  61. {-------------------------------  Register  ---------------------------------}
  62. {  Called by the IDE Options/Install Components                              }
  63. procedure Register;
  64. begin
  65.    RegisterComponents('Samples', [TFormSet]);
  66. end;
  67.  
  68. {--------------------------------  Create  ----------------------------------}
  69. constructor TFormSet.Create;
  70. begin
  71.    inherited Create(Owner);
  72.    OldTabIndex    := TabIndex;
  73.    InternalChange := False;
  74. end;
  75.  
  76. {-----------------------------  ConfigureTab  -------------------------------}
  77. { If no FormTab object for this tab, create one.                             }
  78. { If FormTab.Form not known, call OnTabLoad to get one.                      }
  79. Function TFormSet.ConfigureTab;
  80. var
  81.    FormTab : TFormTab;
  82. begin
  83.    FormTab := Tabs.Objects[TabIndex] as TFormTab;
  84.    if not assigned(FormTab) then
  85.    begin
  86.       FormTab := TFormTab.Create;
  87.       Tabs.Objects[TabIndex] := FormTab;
  88.    end;
  89.    if not assigned(FormTab.Form) then
  90.       if assigned(FOnTabLoad) then
  91.          FOnTabLoad(Self,TabIndex,FormTab);
  92.    Result := assigned(FormTab.Form);
  93. end;
  94.  
  95. {--------------------------------  TabOpen  ---------------------------------}
  96. { Change size of notebook or page as needed.                                 }
  97. { Set required properties on child form.                                     }
  98. procedure TFormSet.TabOpen;
  99. var
  100.    FormTab : TFormTab;
  101.    Child   : TForm;
  102. begin
  103.    FormTab := Tabs.Objects[NewTabIndex] as TFormTab;
  104.    Child   := FormTab.Form;
  105.    if ParentHeight = 0 then ParentHeight := Parent.ClientHeight;
  106.    if ParentWidth  = 0 then ParentWidth  := Parent.ClientWidth;
  107.    if FormTab.OnOpen = ftoSizePageToBook then
  108.    begin
  109.       Parent.ClientHeight := ParentHeight;
  110.       Parent.ClientWidth  := ParentWidth;
  111.    end;
  112.    if FormTab.OnOpen = ftoSizeBookToPage then
  113.    begin
  114.       Parent.ClientHeight := Child.Height;
  115.       Parent.ClientWidth  := Child.Width;
  116.    end;
  117.    Child.Parent      := Parent;
  118.    Child.Align       := alClient;
  119.    Child.BorderStyle := bsNone;
  120.    Child.Visible     := True;
  121. end;
  122.  
  123. {-------------------------------  TabClose  ---------------------------------}
  124. { Release form if necessary                                                  }
  125. procedure TFormSet.TabClose;
  126. var
  127.    FormTab : TFormTab;
  128. begin
  129.    if OldTabIndex < 0 then exit;
  130.    FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
  131.    if not assigned(FormTab) then
  132.       exit;
  133.    if FormTab.OnClose = ftcAlwaysRelease then
  134.    begin
  135.       FormTab.Form.Release;
  136.       FormTab.Form := Nil;
  137.    end
  138.    else
  139.    begin
  140.       FormTab.Form.Hide;
  141.       FormTab.Form.Parent := Nil;
  142.    end;
  143. end;
  144.  
  145. {---------------------------------  Click  ----------------------------------}
  146. { This is the main driver                                                    }
  147. { TabSet has already changed the TabIndex                                    }
  148. { Undo the TabIndex change                                                   }
  149. { If there was a tab/form displayed                                          }
  150. {    fire it's CloseQuery                                                    }
  151. { If the form is not known for the new tab                                   }
  152. {    Configure the new tab/form                                              }
  153. { Fire the OnChange event                                                    }
  154. { Close the old tab                                                          }
  155. { Open the new tab                                                           }
  156. { Redo the index change                                                      }
  157. { Fire the OnClick event                                                     }
  158. {----------------------------------------------------------------------------}
  159. procedure TFormSet.Click;
  160. var
  161.    AllowChange : Boolean;
  162.    NewTabIndex : Integer;
  163.    FormTab     : TFormTab;
  164. begin
  165.    if InternalChange
  166.    or (TabIndex = OldTabIndex) then
  167.       exit;
  168.    InternalChange := True;               { Prevent too much recursion       }
  169.    NewTabIndex    := TabIndex;           { Temporarily undo TabIndex change }
  170.    TabIndex       := OldTabIndex;
  171.    AllowChange    := True;
  172.    if OldTabIndex >= 0 then
  173.    begin
  174.       FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
  175.       if assigned(FormTab) then
  176.          if assigned(FormTab.Form) then
  177.             AllowChange := FormTab.Form.CloseQuery;
  178.    end;
  179.    if AllowChange then
  180.       AllowChange := ConfigureTab(NewTabIndex);
  181.    if AllowChange then
  182.       if assigned(FOnChange) then
  183.          FOnChange(Self,NewTabIndex,AllowChange);
  184.    if AllowChange then
  185.    begin
  186.       TabClose(OldTabIndex);
  187.       TabOpen(NewTabIndex);
  188.       TabIndex    := NewTabIndex;
  189.       OldTabIndex := NewTabIndex;
  190.       if assigned(FOnClick) then
  191.          OnClick(Self);
  192.    end;
  193.    InternalChange := False;
  194. end;
  195.  
  196. Initialization
  197. end.
  198.